Remettez deux fichiers R notebook (.Rmd et .html correspondants) avec les codes et les sorties de R, et les résultats commentés. Ces fichiers doivent être construits en remplissant ce fichier-ci. Les solutions des éxercices des séances vous donnent une idée de la quantité et de la typologie des commentaires requis. Écrivez tout le code de manière qu’on puisse l’exécuter à nouveau en obtenant les mêmes résultats.
En plus, remettez un fichier .mp4 avec une présentation critique des résultats (longueur maximale: 10 minutes; 10 points). Cette partie requiert les logiciels Screencast-O-Matic et Handbrake. Pour les télécharger et les utiliser, consultez les tutoriels dans le fichier “Instructions Screencast-O-matic et HandBrake.pdf”. Vous devez réaliser une présentation où chaque membre de l’équipe intervient. Screencast-O-Matic va vous aider parce qu’il permet de fusionner facilement des vidéos créés séparément.
Nous voulons étudier les décisions d’achat des clients, en ce qui concerne la vente de jus d’orange. Comme le bénéfice marginal est plus élevé sur la vente de jus d’orange Tropicana que sur le jus d’orange Oasis, on voudrait concevoir des stratégies pour améliorer les ventes de ce jus d’orange et augmenter le chiffre d’affaires global de la chaîne de magasins qui vendent les deux.
Le fichier JusOrange.txt contient les informations sur 1070 achats de jus d’orange Tropicana ou Oasis dans des magasins de la même chaîne. En particulier, il contient des variables sur des caractéristiques du client et du produit:
Purchase: variable avec catégories Oasis or Tropicana, indiquant si le client a acheté du jus d’orange Oasis or TropicanaWeekofPurchase: semaine d’achatStoreID: identifiant du magasin (nombre de 1 à 5)PriceOasis: prix de référence (avant les rabais) du jus d’orange OasisPriceTropicana: prix de référence (avant les rabais) du jus d’orange TropicanaListPriceDiff: prix de référence du jus d’orange Tropicana moins prix de référence du jus d’orange OasisDiscOasis: rabais offert sur le jus d’orange OasisDiscTropicana: rabais offert sur le jus d’orange TropicanaPctDiscOasis: pourcentage de rabais sur le jus d’orange OasisPctDiscTropicana: pourcentage de rabais sur le jus d’orange TropicanaSpecialOasis: variable indicatrice de spécial de la semaine sur le jus d’orange Oasis (1: spécial, 0: sinon)SpecialTropicana: variable indicatrice de spécial de la semaine sur le jus d’orange Tropicana (1: spécial, 0: sinon)SalePriceOasis: prix de vente du jus d’orange OasisSalePriceTropicana: prix de vente du jus d’orange TropicanaPriceDiff: prix de vente du jus d’orange Tropicana moins prix de vente du jus d’orange OasisLoyalOasis: indice de fidélité de la clientèle pour la marque Oasis (nombre entre 0 et 1)On souhaite comprendre quelles variables affectent les ventes de jus d’orange de la marque Tropicana, sur la base desquelles les magasins peuvent concevoir des stratégies pour améliorer les ventes de jus d’orange Tropicana et, par conséquent, augmenter le chiffre d’affaires global de la chaîne de magasins. Pour faire ça, on voudrait obtenir un bon modèle pour prédire la probabilité que les clients achètent du jus d’orange Tropicana au lieu du jus d’orange Oasis.
Effectuer une analyse exploratoire des données, afin de se faire une idée des variables qui affectent les ventes de jus d’orange de l’une des deux marques et des relations entre ces variables.
Commencer par vérifier le type de variables et par les changer si nécessaire. Puis, créer des boîtes à moustaches des variables numériques pour les deux classes correspondantes à l’achat de jus d’orange Oasis or Tropicana (variable Purchase; utiliser la même limite pour l’axe y, afin de pouvoir les comparer facilement). Pour les variables qualitatives et binaires, calculer les fréquences dans les deux classes (achats de jus d’orange Oasis ou Tropicana), en utilisant la fonction table. Enfin, créer des nuages de points (scatterplots) pour visualiser les relations entre les variables numériques, en utilisant deux couleurs différentes pour les deux classes (Oasis et Tropicana) et calculer les corrélations entre elles.
# PACKAGES
packages<-function(x){
x<-as.character(match.call()[[2]])
if (!require(x,character.only=TRUE)){
install.packages(pkgs=x,repos="http://cran.r-project.org")
require(x,character.only=TRUE)
}
}
packages(tidyverse)
packages(tree)
# GESTION DE L'AFFICHAGE DES GGPLOTS
packages(ggpubr)
packages(randomForest)
packages(ROCR)
# On importe les données dans un dataframe et on affiche les premières lignes
jus_orange = read.csv('~/Downloads/TP2/JusOrange.txt', header = TRUE, sep = ';')
head(jus_orange)
Voici les données importées brutes :
| Purchase | WeekofPurchase | StoreID | PriceOasis | PriceTropicana | ListPriceDiff | DiscOasis | DiscTropicana | PctDiscOasis | PctDiscTropicana | SpecialOasis | SpecialTropicana | SalePriceOasis | SalePriceTropicana | PriceDiff | LoyalOasis |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Oasis | 237 | 1 | 1.75 | 1.99 | 0.24 | 0.00 | 0.0 | 0.000000 | 0.000000 | 0 | 0 | 1.75 | 1.99 | 0.24 | 0.500000 |
| Oasis | 239 | 1 | 1.75 | 1.99 | 0.24 | 0.00 | 0.3 | 0.000000 | 0.150754 | 0 | 1 | 1.75 | 1.69 | -0.06 | 0.600000 |
| Oasis | 245 | 1 | 1.86 | 2.09 | 0.23 | 0.17 | 0.0 | 0.091398 | 0.000000 | 0 | 0 | 1.69 | 2.09 | 0.40 | 0.680000 |
| Tropicana | 227 | 1 | 1.69 | 1.69 | 0.00 | 0.00 | 0.0 | 0.000000 | 0.000000 | 0 | 0 | 1.69 | 1.69 | 0.00 | 0.400000 |
| Oasis | 228 | 5 | 1.69 | 1.69 | 0.00 | 0.00 | 0.0 | 0.000000 | 0.000000 | 0 | 0 | 1.69 | 1.69 | 0.00 | 0.956535 |
| Oasis | 230 | 5 | 1.69 | 1.99 | 0.30 | 0.00 | 0.0 | 0.000000 | 0.000000 | 0 | 1 | 1.69 | 1.99 | 0.30 | 0.965228 |
Nous vérifions par la suite l’état global du jeu de données :
# TYPES DE VARIABLES ET SOMMAIRE
str(jus_orange)'data.frame': 1070 obs. of 16 variables:
$ Purchase : chr "Oasis" "Oasis" "Oasis" "Tropicana" ...
$ WeekofPurchase : int 237 239 245 227 228 230 232 234 235 238 ...
$ StoreID : int 1 1 1 1 5 5 5 5 5 5 ...
$ PriceOasis : num 1.75 1.75 1.86 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ PriceTropicana : num 1.99 1.99 2.09 1.69 1.69 1.99 1.99 1.99 1.99 1.99 ...
$ ListPriceDiff : num 0.24 0.24 0.23 0 0 0.3 0.3 0.24 0.24 0.24 ...
$ DiscOasis : num 0 0 0.17 0 0 0 0 0 0 0 ...
$ DiscTropicana : num 0 0.3 0 0 0 0 0.4 0.4 0.4 0.4 ...
$ PctDiscOasis : num 0 0 0.0914 0 0 ...
$ PctDiscTropicana : num 0 0.151 0 0 0 ...
$ SpecialOasis : int 0 0 0 0 0 0 1 1 0 0 ...
$ SpecialTropicana : int 0 1 0 0 0 1 1 0 0 0 ...
$ SalePriceOasis : num 1.75 1.75 1.69 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ SalePriceTropicana: num 1.99 1.69 2.09 1.69 1.69 1.99 1.59 1.59 1.59 1.59 ...
$ PriceDiff : num 0.24 -0.06 0.4 0 0 0.3 -0.1 -0.16 -0.16 -0.16 ...
$ LoyalOasis : num 0.5 0.6 0.68 0.4 0.957 ...
summary(jus_orange) Purchase WeekofPurchase StoreID PriceOasis
Length:1070 Min. :227.0 Min. :1.000 Min. :1.690
Class :character 1st Qu.:240.0 1st Qu.:2.000 1st Qu.:1.790
Mode :character Median :257.0 Median :3.000 Median :1.860
Mean :254.4 Mean :3.294 Mean :1.867
3rd Qu.:268.0 3rd Qu.:5.000 3rd Qu.:1.990
Max. :278.0 Max. :5.000 Max. :2.090
PriceTropicana ListPriceDiff DiscOasis DiscTropicana
Min. :1.690 Min. :0.000 Min. :0.00000 Min. :0.0000
1st Qu.:1.990 1st Qu.:0.140 1st Qu.:0.00000 1st Qu.:0.0000
Median :2.090 Median :0.240 Median :0.00000 Median :0.0000
Mean :2.085 Mean :0.218 Mean :0.05186 Mean :0.1234
3rd Qu.:2.180 3rd Qu.:0.300 3rd Qu.:0.00000 3rd Qu.:0.2300
Max. :2.290 Max. :0.440 Max. :0.50000 Max. :0.8000
PctDiscOasis PctDiscTropicana SpecialOasis SpecialTropicana
Min. :0.00000 Min. :0.0000 Min. :0.0000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
Median :0.00000 Median :0.0000 Median :0.0000 Median :0.0000
Mean :0.02731 Mean :0.0593 Mean :0.1477 Mean :0.1617
3rd Qu.:0.00000 3rd Qu.:0.1127 3rd Qu.:0.0000 3rd Qu.:0.0000
Max. :0.25269 Max. :0.4020 Max. :1.0000 Max. :1.0000
SalePriceOasis SalePriceTropicana PriceDiff LoyalOasis
Min. :1.390 Min. :1.190 Min. :-0.6700 Min. :0.000011
1st Qu.:1.750 1st Qu.:1.690 1st Qu.: 0.0000 1st Qu.:0.325257
Median :1.860 Median :2.090 Median : 0.2300 Median :0.600000
Mean :1.816 Mean :1.962 Mean : 0.1465 Mean :0.565782
3rd Qu.:1.890 3rd Qu.:2.130 3rd Qu.: 0.3200 3rd Qu.:0.850873
Max. :2.090 Max. :2.290 Max. : 0.6400 Max. :0.999947
Toutes les données sont de type numérique en dehors de la variable Purchase (qui regroupe deux classes, Oasis et Tropicana), seuls la semaine d’achat, l’identifiant du magasin et les variables binaires SpecialOasiset SpecialTropicana sont du type entier. La variabl eWeekofPurchase peut être considérée comme une variable discrète. Enfin, nous vérifions qu’il n’y ait pas de données manquantes, au nombre de 0. Enfin, la variable PriceDiff comporte des valeurs négatives.
BOXPLOTS
Nous passons la variable catégorielle et les variables binaires en facteurs, et créons les boîtes à moustaches pour toutes les variables numériques, en fonction de Purchase :
jus_orange$Purchase = as.factor(jus_orange$Purchase)
jus_orange$SpecialOasis = ifelse(jus_orange$SpecialOasis == 1, 'Oui', 'Non')
jus_orange$SpecialTropicana = ifelse(jus_orange$SpecialTropicana == 1, 'Oui', 'Non')
jus_orange$SpecialOasis = as.factor(jus_orange$SpecialOasis)
jus_orange$SpecialTropicana = as.factor(jus_orange$SpecialTropicana)
sum(is.na(jus_orange))
# BOXPLOTS - VARIABLES NUMÉRIQUES
# par(mfrow = c(2,3))
# for (i in c(4:10,13:16)){
# boxplot(jus_orange[,i]~Purchase, data = jus_orange, main = names(jus_orange)[i], ylab = '')
# }
plots = list()
# VERSION GGPLOT
for(i in names(jus_orange[,c(4:10,13:16)])) {
plots[[i]] = ggplot(jus_orange, aes(x = Purchase, fill = Purchase)) +
geom_boxplot(aes_string(y = i), position = position_dodge(width = .60), show.legend = "none") +
theme_minimal()
}
ggarrange(plots[[1]], plots[[2]], plots[[3]], plots[[4]], plots[[5]], plots[[6]], plots[[7]], plots[[8]], plots[[9]], plots[[10]], plots[[11]], ncol = 2, nrow = 3)
Nous remarquons plusieurs faits saillants :
PriceOasis : les clients semblent davantage acheter la marque Tropicana lorsque le prix de la marque Oasis est bas. Au contraire, lorsque le prix de la marque Tropicana est élevé, ils n’ont pas de préférence claire.PriceTropicana : la majeure partie des clients achetant la marque Tropicana semblent acheter cette marque lorsque son prix est plus bas.ListPriceDiff : la marque Tropicana est plus chère que la marque Oasis : la différence entre les prix de référence est positive en tout temps. De plus, lorsque la différence de prix est élevée, les clients préfèrent se tourner vers la marque Oasis.DiscOasis, PctDiscOasis : Ces boîtes à moustaches indiquent que les clients vont très nettement profiter du rabais offert sur la marque Oasis et très peu se tourner vers la marque Tropicana.DiscTropicana et PctDiscTropicana : Ces boîtes à moustaches indiquent que les clients vont très nettement profiter du rabais offert sur la marque Tropicana et très peu se tourner vers la marque Oasis en retour.SalePriceOasis : Quand le prix du jus Oasis est élevé, les clients vont acheter la marque Tropicana.SalePriceTropicana : Quand le prix de la marque Oasis est élevé, les clients vont se rabattre sur la marque Oasis.PriceDiff : Il y a des occurences où le prix de la marque Tropicana était moins élevé que celui du jus Oasis. De manière générale, quand le prix de Tropicana est élevé, les clients vont se tourner vers la marque Oasis.LoyalOasis : De manière générale, les clients semblent plus fidèles à la marque Oasis, peu importe la situation.
FRÉQUENCES ABSOLUES
Nous regardons à présent les fréquences absolues pour les variables non numériques, soit Purchase, SpecialOasis et SpecialTropicana :
# FRÉQUENCES
freq_absolues_purchase = table(jus_orange$Purchase)
freq_absolues_oasis = table(jus_orange$SpecialOasis)
freq_absolues_tropi = table(jus_orange$SpecialTropicana)
| Var1 | Freq |
|---|---|
| Oasis | 653 |
| Tropicana | 417 |
Pour la marque Oasis
| Var1 | Freq |
|---|---|
| Non | 912 |
| Oui | 158 |
Pour la marque Tropicana
| Var1 | Freq |
|---|---|
| Non | 897 |
| Oui | 173 |
On remarque que les marques sont en spécial 14.77% des cas pour Oasis et 16.17% pour la marque Tropicana. On note que la marque Tropicana fait davantage de spéciaux que la marque Oasis, même si les clients semblent préférer la marque Oasis.
NUAGES DE POINTS
On regarde ensuite les scatterplots, pour les interactions entre variables numériques :
# SCATTERPLOTS
col_jus = ifelse(jus_orange$Purchase == 'Oasis', 'lightblue', 'red')
par(mfrow = c(1,1))
plot(jus_orange[,c(4:10,13:16)], col = col_jus)
On remarque que les clients semblent assez bien séparés par leur fidélité à l’une ou l’autre marque de jus. La variabilité semble provenir de l’instant où l’une ou l’autre marque observe un rabais sur son prix habituel : lorsque c’est le cas, davantage de clients semblent se tourner vers la marque en rabais. La variable PriceDiff, en étant l’écart de prix, semble fortement influencée par les rabais appliqués sur l’une ou l’autre marque, de même que par le prix de vente final : en effet, ces variations dans les prix viennent réduire ou agrandir l’écart de prix entre les deux marques.
CORRÉLATIONS
# CORRELATIONS
correlations = cor(jus_orange[,c(2:10,13:16)])
| WeekofPurchase | StoreID | PriceOasis | PriceTropicana | ListPriceDiff | DiscOasis | DiscTropicana | PctDiscOasis | PctDiscTropicana | SalePriceOasis | SalePriceTropicana | PriceDiff | LoyalOasis | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| WeekofPurchase | 1.0000000 | 0.0926371 | 0.7043241 | 0.5768723 | 0.0530385 | 0.3657223 | 0.2423341 | 0.3550471 | 0.2235326 | 0.2012561 | 0.1017187 | -0.0116097 | 0.1928972 |
| StoreID | 0.0926371 | 1.0000000 | 0.1341428 | 0.1340704 | 0.0403458 | 0.3053538 | -0.0230418 | 0.3047074 | -0.0215089 | -0.1547784 | 0.0907973 | 0.1662118 | 0.2370803 |
| PriceOasis | 0.7043241 | 0.1341428 | 1.0000000 | 0.6164017 | -0.1779347 | 0.1519000 | 0.1163102 | 0.1346007 | 0.0991574 | 0.5867158 | 0.2293827 | -0.0963351 | 0.0777926 |
| PriceTropicana | 0.5768723 | 0.1340704 | 0.6164017 | 1.0000000 | 0.6651870 | 0.0652064 | -0.0012461 | 0.0599635 | -0.0217474 | 0.3849413 | 0.5328587 | 0.2925944 | 0.1155696 |
| ListPriceDiff | 0.0530385 | 0.0403458 | -0.1779347 | 0.6651870 | 1.0000000 | -0.0625506 | -0.1118477 | -0.0526986 | -0.1212028 | -0.0752937 | 0.4483953 | 0.4570001 | 0.0706593 |
| DiscOasis | 0.3657223 | 0.3053538 | 0.1519000 | 0.0652064 | -0.0625506 | 1.0000000 | 0.0180353 | 0.9990225 | 0.0147180 | -0.7112738 | 0.0194155 | 0.3936154 | 0.1394003 |
| DiscTropicana | 0.2423341 | -0.0230418 | 0.1163102 | -0.0012461 | -0.1118477 | 0.0180353 | 1.0000000 | 0.0185211 | 0.9987932 | 0.0679398 | -0.8468676 | -0.8239080 | -0.0202916 |
| PctDiscOasis | 0.3550471 | 0.3047074 | 0.1346007 | 0.0599635 | -0.0526986 | 0.9990225 | 0.0185211 | 1.0000000 | 0.0153175 | -0.7227756 | 0.0162162 | 0.3967112 | 0.1386839 |
| PctDiscTropicana | 0.2235326 | -0.0215089 | 0.0991574 | -0.0217474 | -0.1212028 | 0.0147180 | 0.9987932 | 0.0153175 | 1.0000000 | 0.0584590 | -0.8567490 | -0.8280972 | -0.0224604 |
| SalePriceOasis | 0.2012561 | -0.1547784 | 0.5867158 | 0.3849413 | -0.0752937 | -0.7112738 | 0.0679398 | -0.7227756 | 0.0584590 | 1.0000000 | 0.1472224 | -0.3909995 | -0.0588871 |
| SalePriceTropicana | 0.1017187 | 0.0907973 | 0.2293827 | 0.5328587 | 0.4483953 | 0.0194155 | -0.8468676 | 0.0162162 | -0.8567490 | 0.1472224 | 1.0000000 | 0.8527979 | 0.0786313 |
| PriceDiff | -0.0116097 | 0.1662118 | -0.0963351 | 0.2925944 | 0.4570001 | 0.3936154 | -0.8239080 | 0.3967112 | -0.8280972 | -0.3909995 | 0.8527979 | 1.0000000 | 0.1042608 |
| LoyalOasis | 0.1928972 | 0.2370803 | 0.0777926 | 0.1155696 | 0.0706593 | 0.1394003 | -0.0202916 | 0.1386839 | -0.0224604 | -0.0588871 | 0.0786313 | 0.1042608 | 1.0000000 |
L’analyse des corrélations montre que les prix de référence des jus sont fortement corrélés à la semaine d’achat : les prix de référence augmentent en moyenne avec les semaines. Cela pourrait être dû à l’augmentation des coûts de production, à l’ajustement des prix en fonction de l’inflation, etc…
Les rabais et les pourcentages de rabais sur les deux marques sont plus ou moins corrélés à la semaine d’achat. Les très fortes corrélations se retrouvent entre les pourcentages de rabais et le rabais en dollars en tant que tel, ce qui est normal, mais on observe également que le prix en rabais du jus Tropicana est fortement corrélé à l’écart de prix PriceDiff observé entre les deux marques.
Les corrélations entre les variables de rabais et les prix de vente sont négatives : quand le rabais augmente, le prix de vente diminue. Il semblerait enfin que le magasin joue un léger rôle dans la fidélité des clients pour la marque Oasis.
Créer un ensemble d’entraînement contenant un échantillon aléatoire de 750 observations du dataset, et un ensemble de test contenant les observations restantes. Utiliser le “seed” 2021.
Ajuster un arbre de classement sur les données d’entraînement, pour prédire si un client achète du jus d’orange Oasis ou Tropicana en utilisant toutes les autres variables comme prédicteurs. Utiliser comme critère de séparation l’entropie, avec argument mindev = 0.005. Regarder les résultats et créer le graphique de l’arbre.
Ensuite, appliquer l’élagage sur l’arbre que vous venez de créer, en utilisant la 10-validation croisée et le taux d’erreur de classification pour choisir le meilleur arbre. Utiliser le “seed” 28. Produire un graphique du taux d’erreur de classification en fonction de la taille des sous-arbres et obtenir le sous-arbre de la taille correspondante au plus petit taux d’erreur en validation croisée. Enfin, regarder les résultats et créer le graphique de l’arbre élagué (pour mieux lire les régles et les étiquettes des feuilles, il peut être utile d’utiliser l’argument cex = 0.7).
On crée ici un ensemble d’entraînement de 750 observations, choisies aléatoirement. L’ensemble de test contient toutes les autres observations, soit 320 observations.
set.seed(2021)
train_index = sample(x = nrow(jus_orange), size = 750, replace = FALSE)
jus_orange_train = jus_orange[train_index,]
jus_orange_test = jus_orange[-train_index,]
MODÈLE INITIAL
tree_large_train = tree(Purchase ~ ., data = jus_orange_train,
control = tree.control(nobs = nrow(jus_orange_train), mindev = 0.005))
summary(tree_large_train)
Classification tree:
tree(formula = Purchase ~ ., data = jus_orange_train, control = tree.control(nobs = nrow(jus_orange_train),
mindev = 0.005))
Variables actually used in tree construction:
[1] "LoyalOasis" "PriceDiff" "WeekofPurchase" "StoreID"
[5] "ListPriceDiff" "DiscOasis" "SpecialOasis" "PriceOasis"
Number of terminal nodes: 20
Residual mean deviance: 0.6189 = 451.8 / 730
Misclassification error rate: 0.136 = 102 / 750
La taille de l’arbre initial est de 20 feuilles. Les variables utilisées sont LoyalOasis, PriceDiff, SpecialOasis, SalePriceTropicana, ListPriceDiff, DiscOasis, PriceOasis et PctDiscOasis. SpecialOasis est la seule des deux variables binaires à être utilisée. L’erreur de classification est de 13.6%, ce qui semble faible. Nous affichons ci-dessous l’arbre et calculons l’erreur totale, ainsi que pour chaque classe :
plot(tree_large_train)
text(tree_large_train, cex = 0.7)
On peut également calculer les erreurs de classement selon la marque et l’erreur totale :
tree_large_pred_test = predict(tree_large_train, jus_orange_test, type = "class")
head(tree_large_pred_test)[1] Oasis Oasis Oasis Oasis Oasis Oasis
Levels: Oasis Tropicana
err_tot_tree_large = mean(tree_large_pred_test != jus_orange_test$Purchase)
err_O_tree_large = mean( (tree_large_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_tree_large = mean( (tree_large_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_tree_large = c(err_tot_tree_large, err_O_tree_large, err_T_tree_large)
errors = cbind(err_tree_large)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
errors err_tree_large
totale 0.2312500
Oasis 0.2463054
Tropicana 0.2051282
On remarque que l’erreur totale est d’environ 23.13%. Le modèle semble mieux classer les achats de jus Tropicana que ceux de la marque Oasis. Nous pouvons réajuster le modèle en élaguant l’arbre :
ÉLAGAGE DE L’ARBRE
set.seed(28)
cv_tree_large_train = cv.tree(tree_large_train, K = 10, FUN = prune.misclass)
cv_tree_large_train$size
[1] 20 13 9 5 2 1
$dev
[1] 137 138 137 140 140 300
$k
[1] -Inf 0.00 0.75 2.00 6.00 169.00
$method
[1] "misclass"
attr(,"class")
[1] "prune" "tree.sequence"
plot(cv_tree_large_train)
D’après le graphique ci-dessus, les erreurs de classement sont au plus faible à partir de 9 feuilles. Nous ajustons le modèle avec comme argument best = 9.
tree_large_pruned = prune.tree(tree_large_train, best = 9, method = "misclass")
summary(tree_large_pruned)
Classification tree:
snip.tree(tree = tree_large_train, nodes = c(7L, 24L, 47L, 13L
))
Variables actually used in tree construction:
[1] "LoyalOasis" "PriceDiff" "WeekofPurchase" "ListPriceDiff"
[5] "DiscOasis"
Number of terminal nodes: 9
Residual mean deviance: 0.7043 = 521.9 / 741
Misclassification error rate: 0.14 = 105 / 750
plot(tree_large_pruned)
text(tree_large_pruned, cex = 0.7)
L’arbre élagué comporte 9 feuilles au total. Ici, seulement cinq variables sont utilisées : on retrouve LoyalOasis, ListPriceDiff, PriceDiff, WeekofPurchase et DiscOasis. Dans ce modèle comme dans le précédent, la fidélité des clients à la marque Oasis semble jouer un rôle important, de même que le rabais appliqué au prix ou la différence de prix entre les marques Oasis et Tropicana. Cependant, l’arbre élagué semble moins précis que l’arbre entier : son erreur de classification est de 14%, soit environ 0.4 points de plus.
COMPARAISON DES DEUX MODÈLES
tree_large_pruned_pred_test = predict(tree_large_pruned, jus_orange_test, type = "class")
err_tot_tree_large_pruned = mean(tree_large_pruned_pred_test != jus_orange_test$Purchase)
err_O_tree_large_pruned = mean( (tree_large_pruned_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_tree_large_pruned = mean( (tree_large_pruned_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_tree_large_pruned = c(err_tot_tree_large_pruned, err_O_tree_large_pruned, err_T_tree_large_pruned)
errors = cbind(err_tree_large, err_tree_large_pruned)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
colnames(errors) = c('default', 'large pruned')
errors default large pruned
totale 0.2312500 0.2343750
Oasis 0.2463054 0.2463054
Tropicana 0.2051282 0.2136752
D’après la matrice, les taux d’erreur totales sont similaires entre les deux modèles, néanmoins, il est à noter que l’arbre élagué performe moins bien sur le classement de la marque Tropicana et mieux sur la marque Oasis. On peut également tracer les courbes ROC et retrouver leurs aires sous la courbe :
COURBES ROC
tree_large_prob_test = predict(tree_large_train, jus_orange_test)[,'Tropicana']
tree_large_pruned_prob_test = predict(tree_large_pruned, jus_orange_test)[,'Tropicana']
pred_tree = prediction(tree_large_prob_test, jus_orange_test$Purchase)
roc_tree = performance(pred_tree, measure = "tpr", x.measure = "fpr")
pred_tree_large_pruned = prediction(tree_large_pruned_prob_test, jus_orange_test$Purchase)
roc_tree_large_pruned = performance(pred_tree_large_pruned, measure = "tpr", x.measure = "fpr")
auc = performance(pred_tree, measure = 'auc')
auc_pruned = performance(pred_tree_large_pruned, measure = 'auc')
plot(roc_tree, col = 'red')
plot(roc_tree_large_pruned, col = 'green', add = TRUE)
abline(0, 1, col = 'darkgray', lty = 2)
legend('bottomright', legend = c('Default tree', 'Large tree pruned'), col = c('red', 'green'), lty = 1)
On voit que le modèle d’arbre élagué performe presque aussi bien que l’arbre initial, les valeurs AUC sont respectivement de 0.8350385 et 0.8352911. Le modèle initial est meilleur pour classer des petites valeurs de faux positifs, tandis que le modèle élagué performe mieux sur les grandes valeurs (la courbe verte se situe au-dessus de la courbe rouge).
Utiliser une forêt aléatoire avec 1000 arbres sur les données d’entraînement (avec nombre de prédicteurs considerés à chaque noeud par défaut) pour prédire si un client achète du jus d’orange Oasis ou Tropicana en utilisant toutes les autres variables comme prédicteurs. Utiliser le “seed” 5. Régarder les résultats et produire un graphique de l’importance des variables.
Enfin, comparer les erreurs de classement (total et pour chaque classe) sur les données out-of-bag, en fonction du nombre d’arbres de 1 à 1000. Quel nombre d’arbres donne le meilleur résultat? Expliquer.
set.seed(5)
bag_train = randomForest(x = jus_orange_train[,-1], y = jus_orange_train$Purchase,
mtry = ncol(jus_orange_train), ntree = 1000, importance = TRUE,
xtest = jus_orange_test[,-1], ytest = jus_orange_test$Purchase)
bag_train
Call:
randomForest(x = jus_orange_train[, -1], y = jus_orange_train$Purchase, xtest = jus_orange_test[, -1], ytest = jus_orange_test$Purchase, ntree = 1000, mtry = ncol(jus_orange_train), importance = TRUE)
Type of random forest: classification
Number of trees: 1000
No. of variables tried at each split: 15
OOB estimate of error rate: 16.67%
Confusion matrix:
Oasis Tropicana class.error
Oasis 385 65 0.1444444
Tropicana 60 240 0.2000000
Test set error rate: 21.88%
Confusion matrix:
Oasis Tropicana class.error
Oasis 162 41 0.2019704
Tropicana 29 88 0.2478632
Les résultats indiquent que 15 variables ont été testées à chaque noeud. Le modèle fait peu d’erreurs out-of-bag (16.67%), légèrement plus sur les données de test (21.88%). Les classes de jus sont mieux prédites dans les données out-of-bag que dans les données de test.
importance(bag_train) Oasis Tropicana MeanDecreaseAccuracy MeanDecreaseGini
WeekofPurchase 14.3853481 21.617122 27.117014 36.702404
StoreID 18.6509177 28.130955 34.056552 15.252514
PriceOasis 9.2452202 11.049554 15.287426 4.352333
PriceTropicana 7.3880328 8.992980 12.177327 3.703322
ListPriceDiff 25.3959414 19.419891 33.781596 19.747054
DiscOasis 0.5029303 7.291513 6.413207 2.572663
DiscTropicana 8.4104234 8.144637 12.591643 2.756509
PctDiscOasis 2.4332097 8.754542 8.493090 2.669697
PctDiscTropicana 7.8289451 9.798256 13.353281 3.226769
SpecialOasis 14.3263577 10.126104 18.615687 3.989358
SpecialTropicana -5.3008905 6.198597 1.852797 1.640817
SalePriceOasis 5.4634902 10.850488 12.441891 5.622810
SalePriceTropicana 6.3088319 21.788088 22.039528 8.637419
PriceDiff 18.1981730 30.236130 37.835756 24.138795
LoyalOasis 132.2504004 153.521044 190.821165 220.240106
varImpPlot(bag_train, main = 'Bagging - Jus Orange')
Il semblerait que l’indice de fidélité soit la variable la plus importante du modèle, suivi par la différence de prix entre les deux marques et enfin du magasin où le jus a été acheté. Pour ce qui est de la semaine d’achat, son importance dépend du critère d’évaluation du modèle. Au contraire, les clients semblent peu réceptifs au fait que le jus de marque Tropicana soit en spécial ou non.
Matrice des probabilités prédites pour chaque classe pour les données de test :
| Oasis | Tropicana | |
|---|---|---|
| 2 | 0.753 | 0.247 |
| 3 | 0.743 | 0.257 |
| 5 | 0.994 | 0.006 |
| 6 | 0.989 | 0.011 |
| 9 | 0.994 | 0.006 |
| 11 | 0.997 | 0.003 |
# CHUNK FACULTATIF : ON REPORTE LA COURBE ROC PLUS TARD AVEC LA COMPARAISON
rf_prob_test = bag_train$test$votes[,'Tropicana']
pred_rf = prediction(rf_prob_test, jus_orange_test$Purchase)
roc_rf = performance(pred_rf, measure = "tpr", x.measure = "fpr")
auc_rf = performance(pred_rf, measure = "auc")
plot(roc_rf, col = 'red')
abline(0, 1, col = 'darkgray', lty = 2)auc = performance(pred_tree, measure = 'auc')
auc_rf@y.values
Si on observe la courbe ROC du modèle, on se rend compte que celui-ci performe très bien, avec une AUC de 0.8493748.
ntree_max = bag_train$ntree
rf_err_tot_oob = bag_train$err.rate[, 1]
rf_err_O_oob = bag_train$err.rate[, 2]
rf_err_T_oob = bag_train$err.rate[, 3]
par( mfrow = c(1,3) )
plot(1:ntree_max, rf_err_tot_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Total error rate', main = 'Out-of-bag results')
plot(1:ntree_max, rf_err_O_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Error rate Oasis', main = 'Out-of-bag results')
plot(1:ntree_max, rf_err_T_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Error rate Tropicana', main = 'Out-of-bag results') Il semblerait que le taux d’erreur total soit au plus bas avec un nombre maximal d’arbres. Pour la marque Oasis, le meilleur résultat se stabilise aux alentours de 600-800 arbres, tandis que pour la marque Tropicana, le taux d’erreur OOB est au plus faible entre 800 et 1000 arbres.
Comparer les résultats de l’arbre élagué obtenu au point B avec les résultats de la forêt aléatoire avec le nombre d’arbres choisi au point C. Utiliser le “seed” 5 pour ajuster à nouveau la forêt aléatoire, si nécessaire. En particulier, calculer les erreurs de classement (total et pour chaque classe) sur les données de test, créer les courbes ROC et calculer l’aire sous la courbe ROC correspondante en utilisant les données de test pour les deux méthodes. Commenter tous les résultats et choisir le modèle le meilleur entre les deux.
Noter que, pour la forêt aléatoire, les classes prédites pour les données de test sont dans la sortie de randomForest, à l’intérieur de la liste test, dans le vecteur appelé predicted. Les probabilités prédites pour chaque classe pour les données de test sont aussi dans la sortie de randomForest, à l’intérieur de la liste test, dans la matrice appelée votes.
rf_pred_test = bag_train$test$predicted
err_tot_rf = mean(rf_pred_test != jus_orange_test$Purchase)
err_O_rf = mean( (rf_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_rf = mean( (rf_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_rf = c(err_tot_rf, err_O_rf, err_O_rf)
errors = cbind(err_tree_large, err_tree_large_pruned, err_rf)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
colnames(errors) = c('default', 'large pruned', 'random forest')
errors default large pruned random forest
totale 0.2312500 0.2343750 0.2187500
Oasis 0.2463054 0.2463054 0.2019704
Tropicana 0.2051282 0.2136752 0.2019704
plot(roc_tree_large_pruned, col = 'green')
plot(roc_rf, col = 'blue', add = TRUE)
abline(0, 1, col = 'darkgray', lty = 2)
legend('bottomright', legend = c('Large tree pruned', 'Random Forest'), col = c('green', 'blue'), lty = 1)
Au niveau des taux d’erreurs, il semblerait que le fait d’élaguer augmente légèrement l’erreur totale. La différence se retrouve dans les erreurs par marque où l’ajustement semble avoir diminué l’erreur de classement pour le jus d’orange Tropicana de 4.17%, tandis que le taux d’erreur pour Oasis augmente de 0%. Les taux d’erreur pour les deux marques sont égaux pour le modèle de forêt aléatoire. Le modèle de forêt aléatoire est celui qui possède le taux d’erreur le plus bas dans les trois catégories. Pour les courbes ROC, les aires sous la courbe sont respectivement de 0.8350385` et de 0.8493748 pour l’arbre élagué et la forêt aléatoire. Le modèle aléatoire performe mieux que le modèle ajusté par un élagage.
Le fichier yield_curves.csv contient les rentabilités à l’échéance d’obligations à coupon zéro d’une durée allant de 3 mois à 30 ans, sur une base trimestrielle (120 échéances au total), pour chaque jour de 22 mars 2019 à 30 novembre 2020. Les courbes des rentabilités quotidiennes ont été générées à partir des données des prix des obligations du gouvernement canadien. Ces données peuvent être téléchargées à partir du site de la Banque du Canada. En particulier, le dataset contient les variables suivantes:
Date: date en format année/mois/jourYield3m, Yield6m, …, Yield360m: rentabilité à échéance 3 mois, 6 mois, …, 360 mois (30 ans); 120 variables au totalLa courbe des rentabilités (ou structure par termes des taux d’intérêt) représente les rentabilités des obligations d’État en fonction de leur échéance.
Le but de l’analyse est de comprendre l’évolution des facteurs de la courbe des rentabilités pendant la période de la COVID-19, afin de clarifier les effets de la pandémie et des politiques monétaires connexes sur les marchés obligataires.
À la suite du début de l’épidémie de COVID-19, la Banque du Canada a annoncé plusieurs mesures pour réduire la panique sur les marchés, parmi lesquelles on a une réduction considérable du taux cible du financement à un jour de 1,75% à 0,25% en mars 2020. Nous souhaitons évaluer les effets des ces interventions de la Banque du Canada sur la structure par termes des taux d’intérêt, en comparant les courbes des rentabilités avant et au cours de la première vague de COVID-19.
En particulier, on veut comparer les trois premières composantes principales des courbes des rentabilités. Ces composantes sont interprétées comme niveau, pente et courbure dans Litterman & Scheinkman (1991). Elles correspondent à des mouvements de la courbe des rentabilités: translation des taux d’intérêt vers le haut ou vers le bas (niveau), incréments à court terme et non à long terme ou vice versa (pente), changements à court et long terme dans une direction et changements aux termes moyens dans la direction opposée (courbure).
Créer deux ensembles des données basés sur les dates: période pré-COVID-19 du 22 mars 2019 au 27 février 2020 et période COVID-19 à partir du 27 mars 2020. Noter qu’on enlève les données du 28 février 2020 au 26 mars 2020, comme c’est la période des interventions de la Banque du Canada et la volatilité est très élevée.
Pour chacune des deux périodes, calculer les moyennes des rentabilités à chaque échéance, c’est-à-dire pour chacune des 120 variables Yield3m, Yield6m, …, Yield360m. Créer un graphique de ces moyennes en fonction de l’échéance et le commenter. Ce graphique constitue une sorte de structure par termes des moyennes des taux. En particulier, commenter les différences entre les deux périodes (rentabilités plus ou moins élevées, forme de la courbe, différences entre les rentabilités à différentes échéances).
# On importe les données dans un dataframe et on affiche les premières lignes
yd_curves = read.csv('~/Downloads/TP2/yield_curves.csv', header = TRUE, sep = ',')
head(yd_curves)
str(yd_curves)
summary(yd_curves)
| Date | Yield3m | Yield6m | Yield9m | Yield12m | Yield15m | Yield18m | Yield21m | Yield24m | Yield27m | Yield30m | Yield33m | Yield36m | Yield39m | Yield42m | Yield45m | Yield48m | Yield51m | Yield54m | Yield57m | Yield60m | Yield63m | Yield66m | Yield69m | Yield72m | Yield75m | Yield78m | Yield81m | Yield84m | Yield87m | Yield90m | Yield93m | Yield96m | Yield99m | Yield102m | Yield105m | Yield108m | Yield111m | Yield114m | Yield117m | Yield120m | Yield123m | Yield126m | Yield129m | Yield132m | Yield135m | Yield138m | Yield141m | Yield144m | Yield147m | Yield150m | Yield153m | Yield156m | Yield159m | Yield162m | Yield165m | Yield168m | Yield171m | Yield174m | Yield177m | Yield180m | Yield183m | Yield186m | Yield189m | Yield192m | Yield195m | Yield198m | Yield201m | Yield204m | Yield207m | Yield210m | Yield213m | Yield216m | Yield219m | Yield222m | Yield225m | Yield228m | Yield231m | Yield234m | Yield237m | Yield240m | Yield243m | Yield246m | Yield249m | Yield252m | Yield255m | Yield258m | Yield261m | Yield264m | Yield267m | Yield270m | Yield273m | Yield276m | Yield279m | Yield282m | Yield285m | Yield288m | Yield291m | Yield294m | Yield297m | Yield300m | Yield303m | Yield306m | Yield309m | Yield312m | Yield315m | Yield318m | Yield321m | Yield324m | Yield327m | Yield330m | Yield333m | Yield336m | Yield339m | Yield342m | Yield345m | Yield348m | Yield351m | Yield354m | Yield357m | Yield360m |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2019-03-22 | 1.66345 | 1.66518 | 1.65846 | 1.65175 | 1.57151 | 1.55843 | 1.54727 | 1.53774 | 1.52966 | 1.52287 | 1.51727 | 1.51275 | 1.50924 | 1.50665 | 1.50494 | 1.50403 | 1.50389 | 1.50446 | 1.50570 | 1.50758 | 1.51005 | 1.51308 | 1.51664 | 1.52070 | 1.52523 | 1.53021 | 1.53560 | 1.54139 | 1.54754 | 1.55404 | 1.56086 | 1.56797 | 1.57537 | 1.58302 | 1.59090 | 1.59900 | 1.60729 | 1.61575 | 1.62437 | 1.63312 | 1.64198 | 1.65094 | 1.65998 | 1.66908 | 1.67822 | 1.68738 | 1.69656 | 1.70573 | 1.71487 | 1.72397 | 1.73302 | 1.74200 | 1.75090 | 1.75970 | 1.76839 | 1.77696 | 1.78540 | 1.79369 | 1.80183 | 1.80980 | 1.81759 | 1.82520 | 1.83262 | 1.83983 | 1.84684 | 1.85363 | 1.86020 | 1.86655 | 1.87267 | 1.87855 | 1.88419 | 1.88959 | 1.89475 | 1.89966 | 1.90432 | 1.90874 | 1.91291 | 1.91683 | 1.92051 | 1.92394 | 1.92713 | 1.93008 | 1.93280 | 1.93528 | 1.93753 | 1.93955 | 1.94135 | 1.94294 | 1.94432 | 1.94549 | 1.94646 | 1.94724 | 1.94783 | 1.94824 | 1.94848 | 1.94856 | 1.94847 | 1.94823 | 1.94785 | 1.94733 | 1.94669 | 1.94592 | 1.94503 | 1.94405 | 1.94296 | 1.94178 | 1.94052 | 1.93918 | 1.93778 | 1.93631 | 1.93479 | 1.93323 | 1.93162 | 1.92998 | 1.92831 | 1.92662 | 1.92492 | 1.92321 | 1.92150 | 1.91979 |
| 2019-03-25 | 1.66414 | 1.66833 | 1.65400 | 1.63968 | 1.52493 | 1.50845 | 1.49511 | 1.48434 | 1.47571 | 1.46890 | 1.46368 | 1.45983 | 1.45719 | 1.45562 | 1.45499 | 1.45519 | 1.45616 | 1.45779 | 1.46005 | 1.46285 | 1.46617 | 1.46995 | 1.47417 | 1.47878 | 1.48377 | 1.48910 | 1.49476 | 1.50073 | 1.50698 | 1.51351 | 1.52029 | 1.52732 | 1.53458 | 1.54205 | 1.54973 | 1.55759 | 1.56563 | 1.57383 | 1.58218 | 1.59067 | 1.59928 | 1.60799 | 1.61680 | 1.62569 | 1.63465 | 1.64365 | 1.65270 | 1.66176 | 1.67083 | 1.67989 | 1.68892 | 1.69792 | 1.70687 | 1.71575 | 1.72455 | 1.73325 | 1.74185 | 1.75033 | 1.75867 | 1.76686 | 1.77490 | 1.78276 | 1.79044 | 1.79794 | 1.80523 | 1.81231 | 1.81917 | 1.82581 | 1.83221 | 1.83837 | 1.84428 | 1.84994 | 1.85535 | 1.86050 | 1.86538 | 1.87000 | 1.87435 | 1.87844 | 1.88226 | 1.88581 | 1.88909 | 1.89211 | 1.89487 | 1.89738 | 1.89962 | 1.90162 | 1.90337 | 1.90489 | 1.90616 | 1.90722 | 1.90805 | 1.90867 | 1.90908 | 1.90930 | 1.90933 | 1.90917 | 1.90885 | 1.90837 | 1.90773 | 1.90695 | 1.90604 | 1.90500 | 1.90385 | 1.90260 | 1.90125 | 1.89982 | 1.89831 | 1.89674 | 1.89511 | 1.89344 | 1.89173 | 1.88999 | 1.88823 | 1.88647 | 1.88470 | 1.88293 | 1.88118 | 1.87945 | 1.87774 | 1.87607 |
| 2019-03-26 | 1.66418 | 1.66923 | 1.66000 | 1.65076 | 1.54382 | 1.52736 | 1.51374 | 1.50249 | 1.49329 | 1.48587 | 1.48003 | 1.47559 | 1.47238 | 1.47029 | 1.46920 | 1.46901 | 1.46964 | 1.47101 | 1.47305 | 1.47571 | 1.47893 | 1.48268 | 1.48690 | 1.49156 | 1.49664 | 1.50209 | 1.50790 | 1.51404 | 1.52048 | 1.52722 | 1.53421 | 1.54146 | 1.54893 | 1.55662 | 1.56450 | 1.57255 | 1.58078 | 1.58914 | 1.59764 | 1.60625 | 1.61497 | 1.62376 | 1.63263 | 1.64155 | 1.65051 | 1.65950 | 1.66849 | 1.67748 | 1.68645 | 1.69539 | 1.70427 | 1.71310 | 1.72185 | 1.73051 | 1.73906 | 1.74751 | 1.75582 | 1.76400 | 1.77203 | 1.77990 | 1.78759 | 1.79511 | 1.80243 | 1.80955 | 1.81647 | 1.82317 | 1.82965 | 1.83591 | 1.84192 | 1.84770 | 1.85324 | 1.85853 | 1.86356 | 1.86835 | 1.87288 | 1.87716 | 1.88117 | 1.88494 | 1.88844 | 1.89170 | 1.89470 | 1.89745 | 1.89996 | 1.90222 | 1.90424 | 1.90603 | 1.90760 | 1.90893 | 1.91006 | 1.91097 | 1.91167 | 1.91218 | 1.91250 | 1.91264 | 1.91261 | 1.91241 | 1.91205 | 1.91155 | 1.91091 | 1.91013 | 1.90924 | 1.90823 | 1.90712 | 1.90591 | 1.90462 | 1.90325 | 1.90182 | 1.90032 | 1.89878 | 1.89719 | 1.89557 | 1.89393 | 1.89226 | 1.89059 | 1.88892 | 1.88725 | 1.88559 | 1.88394 | 1.88233 | 1.88074 |
| 2019-03-27 | 1.66347 | 1.66234 | 1.64544 | 1.62854 | 1.51398 | 1.49313 | 1.47639 | 1.46310 | 1.45273 | 1.44484 | 1.43907 | 1.43511 | 1.43270 | 1.43161 | 1.43164 | 1.43264 | 1.43446 | 1.43699 | 1.44013 | 1.44380 | 1.44792 | 1.45245 | 1.45733 | 1.46253 | 1.46801 | 1.47376 | 1.47974 | 1.48596 | 1.49239 | 1.49902 | 1.50584 | 1.51286 | 1.52005 | 1.52742 | 1.53497 | 1.54268 | 1.55054 | 1.55857 | 1.56673 | 1.57504 | 1.58348 | 1.59204 | 1.60072 | 1.60949 | 1.61836 | 1.62730 | 1.63632 | 1.64538 | 1.65449 | 1.66361 | 1.67275 | 1.68189 | 1.69100 | 1.70008 | 1.70910 | 1.71806 | 1.72693 | 1.73571 | 1.74437 | 1.75290 | 1.76128 | 1.76951 | 1.77756 | 1.78542 | 1.79309 | 1.80054 | 1.80777 | 1.81476 | 1.82151 | 1.82800 | 1.83423 | 1.84020 | 1.84588 | 1.85128 | 1.85639 | 1.86121 | 1.86574 | 1.86996 | 1.87389 | 1.87752 | 1.88085 | 1.88389 | 1.88663 | 1.88908 | 1.89125 | 1.89313 | 1.89474 | 1.89608 | 1.89715 | 1.89798 | 1.89856 | 1.89890 | 1.89901 | 1.89891 | 1.89861 | 1.89811 | 1.89743 | 1.89658 | 1.89557 | 1.89442 | 1.89313 | 1.89172 | 1.89020 | 1.88859 | 1.88690 | 1.88514 | 1.88332 | 1.88146 | 1.87956 | 1.87765 | 1.87573 | 1.87381 | 1.87190 | 1.87002 | 1.86818 | 1.86638 | 1.86464 | 1.86296 | 1.86135 | 1.85982 |
| 2019-03-28 | 1.66763 | 1.66452 | 1.65780 | 1.65108 | 1.53611 | 1.51677 | 1.50107 | 1.48843 | 1.47840 | 1.47061 | 1.46475 | 1.46053 | 1.45773 | 1.45614 | 1.45561 | 1.45598 | 1.45714 | 1.45898 | 1.46141 | 1.46437 | 1.46780 | 1.47164 | 1.47586 | 1.48042 | 1.48529 | 1.49046 | 1.49591 | 1.50162 | 1.50758 | 1.51378 | 1.52022 | 1.52688 | 1.53375 | 1.54084 | 1.54814 | 1.55563 | 1.56331 | 1.57118 | 1.57922 | 1.58742 | 1.59578 | 1.60429 | 1.61293 | 1.62169 | 1.63056 | 1.63952 | 1.64856 | 1.65767 | 1.66682 | 1.67602 | 1.68522 | 1.69443 | 1.70363 | 1.71279 | 1.72190 | 1.73094 | 1.73991 | 1.74877 | 1.75752 | 1.76613 | 1.77460 | 1.78291 | 1.79104 | 1.79898 | 1.80671 | 1.81423 | 1.82152 | 1.82857 | 1.83537 | 1.84191 | 1.84818 | 1.85418 | 1.85989 | 1.86531 | 1.87044 | 1.87528 | 1.87981 | 1.88404 | 1.88796 | 1.89158 | 1.89490 | 1.89792 | 1.90064 | 1.90306 | 1.90520 | 1.90705 | 1.90862 | 1.90991 | 1.91094 | 1.91172 | 1.91225 | 1.91253 | 1.91260 | 1.91244 | 1.91207 | 1.91151 | 1.91077 | 1.90986 | 1.90878 | 1.90756 | 1.90621 | 1.90473 | 1.90315 | 1.90147 | 1.89971 | 1.89788 | 1.89599 | 1.89406 | 1.89210 | 1.89012 | 1.88813 | 1.88614 | 1.88417 | 1.88223 | 1.88032 | 1.87846 | 1.87665 | 1.87491 | 1.87324 | 1.87165 |
| 2019-03-29 | 1.66527 | 1.67826 | 1.68686 | 1.69546 | 1.59590 | 1.57857 | 1.56416 | 1.55240 | 1.54302 | 1.53574 | 1.53030 | 1.52645 | 1.52400 | 1.52276 | 1.52257 | 1.52329 | 1.52480 | 1.52699 | 1.52979 | 1.53310 | 1.53688 | 1.54107 | 1.54563 | 1.55051 | 1.55569 | 1.56114 | 1.56685 | 1.57278 | 1.57894 | 1.58531 | 1.59188 | 1.59863 | 1.60556 | 1.61267 | 1.61994 | 1.62737 | 1.63495 | 1.64267 | 1.65053 | 1.65852 | 1.66662 | 1.67483 | 1.68314 | 1.69153 | 1.70000 | 1.70853 | 1.71712 | 1.72574 | 1.73439 | 1.74304 | 1.75170 | 1.76033 | 1.76893 | 1.77749 | 1.78599 | 1.79441 | 1.80274 | 1.81096 | 1.81906 | 1.82704 | 1.83486 | 1.84253 | 1.85002 | 1.85733 | 1.86444 | 1.87135 | 1.87804 | 1.88450 | 1.89073 | 1.89671 | 1.90244 | 1.90791 | 1.91311 | 1.91805 | 1.92271 | 1.92710 | 1.93121 | 1.93504 | 1.93858 | 1.94185 | 1.94483 | 1.94754 | 1.94997 | 1.95213 | 1.95402 | 1.95564 | 1.95701 | 1.95813 | 1.95900 | 1.95964 | 1.96004 | 1.96023 | 1.96021 | 1.95998 | 1.95957 | 1.95897 | 1.95821 | 1.95728 | 1.95621 | 1.95500 | 1.95367 | 1.95223 | 1.95068 | 1.94905 | 1.94734 | 1.94556 | 1.94373 | 1.94186 | 1.93996 | 1.93804 | 1.93611 | 1.93418 | 1.93227 | 1.93037 | 1.92851 | 1.92669 | 1.92492 | 1.92321 | 1.92156 | 1.91999 |
SÉPARATION DES SETS DE PÉRIODES PRÉCOVID ET COVID, CALCUL DES TAUX MOYENS ET GRAPHIQUE
# AGREGATION
yd_cv_average = matrix(NA, 120, 4, byrow = TRUE) %>%
as.data.frame()
for (i in 2:ncol(yd_curves)) {
yd_cv_average[i-1,1] = colnames(yd_curves)[i]
yd_cv_average[i-1,2] = mean(yd_curves[1:233,i])
yd_cv_average[i-1,3] = mean(yd_curves[234:nrow(yd_curves),i])
yd_cv_average[i-1,4] = seq(3,360,3)[i-1]
}
# ATTRIBUTION DES NOMS DE COLONNES
colnames(yd_cv_average) = c("Yield", "precovid", "covid", "echeance")
# GRAPHIQUE
ggplot(yd_cv_average, aes(x = echeance)) +
geom_jitter(aes(y = precovid, col = 'blue')) +
geom_jitter(aes(y = covid, col = 'red')) +
scale_color_discrete(labels = c("Période pré-Covid", "Période Covid")) +
theme_minimal() +
ylim(c(0,2)) +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, selon la période") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
Nous constatons qu’après intervention de la banque centrale, les taux à court terme et à long terme ont diminué. Cependant, les taux moyens à CT ont baissé davantage que les taux moyens à LT, ce qui fait que la structure à terme des taux est devenue croissante avec des taux à CT plus bas que les taux à LT. C’est ce que l’on vise.
Cette baisse s’explique par le fait que, comme les banques vont se financer à des taux interbancaires plus bas au niveau de la banque centrale, elles vont pouvoir prêter aux entreprises à des taux plus bas. Aussi, lorsqu’il y a moins de risque, les investisseurs demandent moins de rendement, ce qui va faire diminuer le niveau des taux de rendement de façon générale, aussi bien pour les taux à CT que pour les taux à LT, et permettra une relance de l’économie.
Les taux à court terme diminuent davantage que les taux à LT. Ainsi, l’intervention gouvernementale à fait en sorte que les différentes parties sur le marché soient rassurées.Ce regain de confiance sur l’avenir a poussé les investisseurs à investir de nouveau sur le long terme et exiger plus de rendement, car ils se privent de leur argent plus longtemps. Pour la première courbe, en rouge, la structure est presque plate (l’amplitude de la courbe est faible), dans le sens où les taux à CT étaient presque équivalents aux taux à LT.
Effectuer une analyse en composantes principales pour les rentabilités à chaque échéance dans les deux périodes. Ne pas mettre à l’échelle les 120 variables, puisq’elles ont déjà toutes la même échelle (elles sont des rendements en pourcentage). Considérer seulement les premières trois composantes (qui peuvent être interprétées comme niveau, pente et courbure).
Pour chaque période: * Créer un graphique de la proportion de variance expliquée par chacune des premières trois composantes et un graphique de la variance cumulative expliquée par les premières 1, 2 et 3 composantes. Commenter les résultats. * Visualiser et interpreter les chargements (“loadings”) pour les premières trois composantes (à quoi corresponds grossièrement chaque composante?)
MODÈLE EN COMPOSANTES PRINCIPALES
Note : les rangs 1 à 233 concernent les observations pré-Covid. Les rangs 234 jusqu’à la fin concernent les observations en période Covid.
pc_yield_precovid = prcomp(yd_curves[1:233,2:121], scale. = FALSE)
head(pc_yield_precovid)
pc_yield_covid = prcomp(yd_curves[234:nrow(yd_curves),2:121], scale. = FALSE)
head(pc_yield_covid)
CALCUL DU PVE ET PVE CUMULÉ
pc_var_precovid = pc_yield_precovid$sdev^2
PVE_precovid = pc_var_precovid / sum(pc_var_precovid)
head(PVE_precovid)
pc_var_covid = pc_yield_covid$sdev^2
PVE_covid = pc_var_covid / sum(pc_var_covid)
head(PVE_covid)
par(mfrow = c(2,2))
barplot(PVE_precovid[1:3], ylim = c(0,1), names.arg = paste('PC', 1:3), xlab = 'Components', main = 'PVE - Période pré-COVID', ylab = 'PVE')
barplot(cumsum(PVE_precovid[1:3]), ylim = c(0,1), names.arg = 1:3, xlab = 'Number of components', main = 'Cumulative PVE - Période pré-COVID', ylab = 'PVE')
barplot(PVE_covid[1:3], ylim = c(0,1), names.arg = paste('PC', 1:3), xlab = 'Components', main = 'PVE - Période COVID', ylab = 'PVE')
barplot(cumsum(PVE_covid[1:3]), ylim = c(0,1), names.arg = 1:3, xlab = 'Number of components', main = 'Cumulative PVE - Période COVID', ylab = 'PVE')
Dans les deux périodes, la première composante PC1 explique plus de 80% de la variance des données. Le reste de la variance est expliqué par les composantes PC2 et PC3. Dans ce cas, il suffit d’utiliser la première composante pour expliquer la majeure partie des données.
Période pré-COVID
loadings = pc_yield_precovid$rotation[,1:3]
M = ncol(loadings)
par(mfrow = c(3,1))
for (i in 1:M) {
barplot(loadings[,i], ylim = c(-0.4,0.4), main = paste("Principal component ", i))
abline(h=0)
}
Période COVID
loadings_covid = pc_yield_covid$rotation[,1:3]
M = ncol(loadings)
par(mfrow = c(3,1))
for (i in 1:M) {
barplot(loadings_covid[,i], ylim = c(-0.4,0.4), main = paste("Principal component ", i))
abline(h=0)
}
Période pré-COVID
Pour la composante 1, l’intervention de la banque centrale produit un effet similaire, peu importe l’échéance. Pour la composante 2, l’intervention de la banque centrale produit des effets différents selon que l’échéance soit à court et moyen terme, ou bien à long terme. Pour la composante 3, l’intervention a un effet différent, suivant l’échéance à CT, MT ou LT.
Période COVID Pour la composante 1, la tendance est similaire à la composante 1 de la période pré-COVID. Pour les composantes 2 et 3, les tendances sont inverses à ce qui est observé pendant la période pré-COVID.
Cette tâche est OPTIONNELLE
Pour chaque période et chacune des premières trois composantes principales, créer des graphiques des chocs. C’est-à-dire, des graphiques montrant la courbe des rentabilités moyennes à chaque échéance (la courbe affichée dans le point A), aussi que la courbe des rentabilités moyennes plus deux fois l’écart-type de la composante multiplié par le loading de la composante (courbe positivement choquée) et la courbe des rentabilités moyennes moins deux fois l’écart-type de la composante multiplié par le loading de la composante (courbe négativement choquée).
Ces graphiques sont utiles pour bien interpreter l’effet de chaque composante principale sur la courbe des rentabilités moyennes.
# PERIODE PRECOVID
# CHOCS POSITIFS
# COMPOSANTE 1
loading_comp_pos_1 = pc_yield_precovid$rotation[,1]
data_courbe_precovid_comp_pos_1 = matrix(0,120,1)
mean_col_pos_precovid = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_pos_1[i] = mean_col_pos_precovid[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_1[i]
}
# COMPOSANTE 2
loading_comp_pos_2 = pc_yield_precovid$rotation[,2]
data_courbe_precovid_comp_pos_2 = matrix(0,120,1)
mean_col_pos_precovid_2 = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_pos_2[i] = mean_col_pos_precovid_2[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_2[i]
}
# COMPOSANTE 3
loading_comp_pos_3 = pc_yield_precovid$rotation[,3]
data_courbe_precovid_comp_pos_3 = matrix(0,120,1)
mean_col_pos_precovid_3 = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_pos_3[i] = mean_col_pos_precovid_3[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_3[i]
}
# CHOCS NEGATIFS
# COMPOSANTE 1
loading_comp_neg_1 = pc_yield_precovid$rotation[,1]
data_courbe_precovid_comp_neg_1 = matrix(0,120,1)
mean_col_neg_precovid = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_neg_1[i] = mean_col_neg_precovid[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_1[i]
}
# COMPOSANTE 2
loading_comp_neg_2 = pc_yield_precovid$rotation[,2]
data_courbe_precovid_comp_neg_2 = matrix(0,120,1)
mean_col_neg_precovid_2 = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_neg_2[i] = mean_col_neg_precovid_2[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_2[i]
}
# COMPOSANTE 3
loading_comp_neg_3 = pc_yield_precovid$rotation[,3]
data_courbe_precovid_comp_neg_3 = matrix(0,120,1)
mean_col_neg_precovid_3 = apply(yd_curves[1:233,2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_precovid_comp_neg_3[i] = mean_col_neg_precovid_3[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_3[i]
}# PERIODE COVID
# CHOCS POSITIFS
# COMPOSANTE 1
loading_comp_pos_1 = pc_yield_covid$rotation[,1]
data_courbe_covid_comp_pos_1 = matrix(0,120,1)
mean_col_pos_covid = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_pos_1[i] = mean_col_pos_covid[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_1[i]
}
# COMPOSANTE 2
loading_comp_pos_2 = pc_yield_covid$rotation[,2]
data_courbe_covid_comp_pos_2 = matrix(0,120,1)
mean_col_pos_covid_2 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_pos_2[i] = mean_col_pos_covid_2[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_2[i]
}
# COMPOSANTE 3
loading_comp_pos_3 = pc_yield_covid$rotation[,3]
data_courbe_covid_comp_pos_3 = matrix(0,120,1)
mean_col_pos_covid_3 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_pos_3[i] = mean_col_pos_covid_3[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_3[i]
}
# CHOCS NEGATIFS
# COMPOSANTE 1
loading_comp_neg_1 = pc_yield_covid$rotation[,1]
data_courbe_covid_comp_neg_1 = matrix(0,120,1)
mean_col_neg_covid = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_neg_1[i] = mean_col_neg_covid[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_1[i]
}
# COMPOSANTE 2
loading_comp_neg_2 = pc_yield_covid$rotation[,2]
data_courbe_covid_comp_neg_2 = matrix(0,120,1)
mean_col_neg_covid_2 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_neg_2[i] = mean_col_neg_covid_2[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_2[i]
}
# COMPOSANTE 3
loading_comp_neg_3 = pc_yield_covid$rotation[,3]
data_courbe_covid_comp_neg_3 = matrix(0,120,1)
mean_col_neg_covid_3 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)
for(i in 1:120) {
data_courbe_covid_comp_neg_3[i] = mean_col_neg_covid_3[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_3[i]
}
data_all_precovid = data.frame(mean_col_pos_precovid, data_courbe_precovid_comp_pos_1, data_courbe_precovid_comp_pos_2, data_courbe_precovid_comp_pos_3, data_courbe_precovid_comp_neg_1, data_courbe_precovid_comp_neg_2, data_courbe_precovid_comp_neg_3)
data_all_covid = data.frame(mean_col_pos_covid, data_courbe_covid_comp_pos_1, data_courbe_covid_comp_pos_2, data_courbe_covid_comp_pos_3, data_courbe_covid_comp_neg_1, data_courbe_covid_comp_neg_2, data_courbe_covid_comp_neg_3)
x = seq(3,360,3)
POUR LA PERIODE PRECOVID
ggplot(data_all_precovid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
geom_line(aes(y = data_courbe_precovid_comp_pos_1, col = 'red')) +
geom_line(aes(y = data_courbe_precovid_comp_neg_1, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 1") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))ggplot(data_all_precovid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
geom_line(aes(y = data_courbe_precovid_comp_pos_2, col = 'red')) +
geom_line(aes(y = data_courbe_precovid_comp_neg_2, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 2") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))ggplot(data_all_precovid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
geom_line(aes(y = data_courbe_precovid_comp_pos_3, col = 'red')) +
geom_line(aes(y = data_courbe_precovid_comp_neg_3, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 3") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
Pour la période pré-COVID, on constate que pour la composante 1, quand il y a un choc positif (bonne nouvelle), les taux moyens à court terme augmentent, alors que lorsqu’il y a un choc négatif (mauvaise nouvelle), les taux moyens à court terme diminuent. On constate également que l’impact des chocs est seulement sur le court terme. Il semblerait qu’après un certain temps, l’effet des chocs positif comme négatif s’estompe.
Pour la composante 2, l’effet à court terme est similaire à celui de la composante 1, mais l’effet du choc négatif se prolonge sur le moyen terme.
Pour la composante 3, nous observons l’inverse des situations des deux autres composantes : suite à un choc positif, les taux moyens à court terme diminuent fortement, tandis que ces mêmes taux augmentent suite à un choc négatif. On peut en déduire que cette composante ne permet pas d’expliquer l’effet de la politique de la Banque du Canada.
POUR LA PERIODE COVID
Voici les graphiques pour la période COVID :
ggplot(data_all_covid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
geom_line(aes(y = data_courbe_covid_comp_pos_1, col = 'red')) +
geom_line(aes(y = data_courbe_covid_comp_neg_1, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 1") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))ggplot(data_all_covid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
geom_line(aes(y = data_courbe_covid_comp_pos_2, col = 'red')) +
geom_line(aes(y = data_courbe_covid_comp_neg_2, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 2") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))ggplot(data_all_covid, aes(x = x)) +
geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
geom_line(aes(y = data_courbe_covid_comp_pos_3, col = 'red')) +
geom_line(aes(y = data_courbe_covid_comp_neg_3, col = 'blue')) +
theme_minimal() +
labs(x = "Échéance",
y = "Average yield",
col = "Situation") +
scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 3") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
Pour les données en période de crise, pour la composante 1, lorsqu’il y a un choc positif, les taux moyens à CT diminuent alors que lors d’un choc négatif, les taux moyens à CT augmentent. Les chocs ne semblent pas impacter les taux à LT.
Pour la composante 2, on constate l’inverse de la composante 1.
Pour la composante 3, l’effet est similaire à la composante 1, mais est davantage prononcé et plus durable.
Comparer les premières trois composantes principales obtenues pour les deux périodes (avant et au cours de la première vague de COVID-19). Quels ont été les effets de l’intervention de la Banque du Canada sur la structure par termes des taux d’intérêt?
loadings = as.data.frame(loadings)
loadings_covid = as.data.frame(loadings_covid)
loadings$x = x
loadings_covid$x = x
loadings_all = loadings %>%
full_join(., loadings_covid, by = c('x' = 'x'))
colnames(loadings_all) = c("PC1_precovid", "PC2_precovid", "PC3_precovid", "x", "PC1_covid", "PC2_covid", "PC3_covid")
pc_1 = ggplot(loadings_all, aes(x = x)) +
geom_line(aes(y = PC1_precovid, col = "red")) +
geom_line(aes(y = PC1_covid, col = "blue")) +
theme_minimal() +
labs(x = "Échéance",
y = " ",
col = "Situation") +
scale_color_discrete(labels = c("PC1 pré COVID", "PC1 COVID")) +
ggtitle("COMPOSANTE 1") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
pc_2 = ggplot(loadings_all, aes(x = x)) +
geom_line(aes(y = PC2_precovid, col = "red")) +
geom_line(aes(y = PC2_covid, col = "blue")) +
theme_minimal() +
labs(x = "Échéance",
y = " ",
col = "Situation") +
scale_color_discrete(labels = c("PC1 pré COVID", "PC1 COVID")) +
ggtitle("COMPOSANTE 2") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
pc_3 = ggplot(loadings_all, aes(x = x)) +
geom_line(aes(y = PC3_precovid, col = "red")) +
geom_line(aes(y = PC3_covid, col = "blue")) +
theme_minimal() +
labs(x = "Échéance",
y = " ",
col = "Situation") +
scale_color_discrete(labels = c("PC3 pré COVID", "PC3 COVID")) +
ggtitle("COMPOSANTE 3") +
theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10))
ggarrange(pc_1, pc_2, pc_3, nrow = 3, ncol = 1)
Pour chaque composante, on observe que lorsque la tendance est à la hausse pour l’une des périodes, la tendance est inverse dans l’autre période. Comme vu précédemment à la tâche A, l’effet de l’intervention de la Banque du Canada sur la structure à terme produit une baisse des taux moyens à court terme plus rapide que celle des taux moyens à long terme. Ainsi, après l’intervention en période COVID, la structure à terme est croissante.